home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / update1a / frmmidi.frm (.txt) < prev    next >
Visual Basic Form  |  1999-07-26  |  4KB  |  140 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMidi 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Midi Player for <Your Program Name Here>"
  5.    ClientHeight    =   5016
  6.    ClientLeft      =   48
  7.    ClientTop       =   336
  8.    ClientWidth     =   3936
  9.    ControlBox      =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   5016
  13.    ScaleWidth      =   3936
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.CommandButton Command3 
  16.       Caption         =   "&OK"
  17.       Height          =   372
  18.       Left            =   120
  19.       TabIndex        =   5
  20.       Top             =   4560
  21.       Width           =   3732
  22.    End
  23.    Begin VB.FileListBox File1 
  24.       Height          =   3912
  25.       Left            =   2040
  26.       TabIndex        =   4
  27.       Top             =   120
  28.       Width           =   1812
  29.    End
  30.    Begin VB.DriveListBox Drive1 
  31.       Height          =   288
  32.       Left            =   120
  33.       TabIndex        =   3
  34.       Top             =   120
  35.       Width           =   1812
  36.    End
  37.    Begin VB.DirListBox Dir1 
  38.       Height          =   3528
  39.       Left            =   120
  40.       TabIndex        =   2
  41.       Top             =   480
  42.       Width           =   1812
  43.    End
  44.    Begin VB.CommandButton Command2 
  45.       Caption         =   "&Stop"
  46.       Height          =   375
  47.       Left            =   2040
  48.       TabIndex        =   1
  49.       Top             =   4080
  50.       Width           =   1812
  51.    End
  52.    Begin VB.CommandButton Command1 
  53.       Caption         =   "&Play"
  54.       Default         =   -1  'True
  55.       Height          =   375
  56.       Left            =   120
  57.       TabIndex        =   0
  58.       Top             =   4080
  59.       Width           =   1812
  60.    End
  61. Attribute VB_Name = "frmMidi"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = False
  64. Attribute VB_PredeclaredId = True
  65. Attribute VB_Exposed = False
  66. Public Sub OpenMidi()
  67. Dim sFile As String
  68. Dim sShortFile As String * 67
  69. Dim lResult As Long
  70. Dim sError As String * 255
  71. 'Set the path and filename to open. I am using the 'mcitest.mid which I found in my VB5 directory in 'the sub folders samples\comptool\mci 'I just copied it to this projects folder.
  72. sFile = Dir1.Path & "\" & File1.filename
  73. 'The mciSendString API call doesn't seem to like' 'long filenames that have spaces in them, so we 'will make another API call to get the short 'filename version.
  74. lResult = GetShortPathName(sFile, sShortFile, Len(sShortFile))
  75. sFile = Left(sShortFile, lResult)
  76. 'Make the call to open the midi file and assign 'it an alias
  77. lResult = mciSendString("open " & sFile & " type sequencer alias mcitest", ByVal 0&, 0, 0)
  78. 'Check to see if there was an error
  79. If lResult Then
  80. lResult = mciGetErrorString(lResult, sError, 255)
  81. Debug.Print "open: " & sError
  82. End If
  83. End Sub
  84. Public Sub PlayMidi()
  85. Dim lResult As Integer
  86. Dim sError As String * 255
  87. 'Make the call to start playing the midi
  88. lResult = mciSendString("play mcitest", ByVal 0&, 0, 0)
  89. 'Check to see if there were any errors
  90. If lResult Then
  91. lResult = mciGetErrorString(lResult, sError, 255)
  92. Debug.Print "play: " & sError
  93. End If
  94. End Sub
  95. Public Sub CloseMidi()
  96. Dim lResult As Integer
  97. Dim sError As String * 255
  98. 'Make the call to close the midi file
  99. lResult = mciSendString("close mcitest", "", 0&, 0&)
  100. 'Check to see if there were any errors
  101. If lResult Then
  102. lResult = mciGetErrorString(lResult, sError, 255)
  103. Debug.Print "stop: " & sError
  104. End If
  105. End Sub
  106. Private Sub Command1_Click()
  107. OpenMidi
  108. PlayMidi
  109.     Command1.Caption = "Playing"
  110.     Command2.Caption = "Stop"
  111. End Sub
  112. Private Sub Command2_Click()
  113. CloseMidi
  114. Command2.Caption = "Stopped"
  115. Command1.Caption = "Play"
  116. End Sub
  117. Private Sub Command3_Click()
  118. Unload Me
  119. End Sub
  120. Private Sub Dir1_Change()
  121. On Error GoTo MidErr2
  122. File1.Path = Dir1.Path
  123. MidErr2:
  124. End Sub
  125. Private Sub Drive1_Change()
  126. On Error GoTo MidErr1
  127. Dir1.Path = Drive1.Drive
  128. MidErr1:
  129. End Sub
  130. Private Sub File1_DblClick()
  131. OpenMidi
  132. PlayMidi
  133. Command1.Caption = "Playing"
  134. Command2.Caption = "Stop"
  135. End Sub
  136. Private Sub Form_Load()
  137. File1.Pattern = "*.mid"
  138. Dir1.Path = "C:\"
  139. End Sub
  140.